home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / src / tclGet.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-25  |  6.2 KB  |  215 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCL_GET
  3. #endif
  4.  
  5. /* 
  6.  * tclGet.c --
  7.  *
  8.  *    This file contains procedures to convert strings into
  9.  *    other forms, like integers or floating-point numbers or
  10.  *    booleans, doing syntax checking along the way.
  11.  *
  12.  * Copyright (c) 1990-1993 The Regents of the University of California.
  13.  * All rights reserved.
  14.  *
  15.  * Permission is hereby granted, without written agreement and without
  16.  * license or royalty fees, to use, copy, modify, and distribute this
  17.  * software and its documentation for any purpose, provided that the
  18.  * above copyright notice and the following two paragraphs appear in
  19.  * all copies of this software.
  20.  * 
  21.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  22.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  23.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  24.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  25.  *
  26.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  27.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  28.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  29.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  30.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  31.  */
  32.  
  33. #ifndef lint
  34. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclGet.c,v 1.14 93/08/18 16:07:24 ouster Exp $ SPRITE (Berkeley)";
  35. #endif /* not lint */
  36.  
  37. #include "tclInt.h"
  38.  
  39. /*
  40.  *----------------------------------------------------------------------
  41.  *
  42.  * Tcl_GetInt --
  43.  *
  44.  *    Given a string, produce the corresponding integer value.
  45.  *
  46.  * Results:
  47.  *    The return value is normally TCL_OK;  in this case *intPtr
  48.  *    will be set to the integer value equivalent to string.  If
  49.  *    string is improperly formed then TCL_ERROR is returned and
  50.  *    an error message will be left in interp->result.
  51.  *
  52.  * Side effects:
  53.  *    None.
  54.  *
  55.  *----------------------------------------------------------------------
  56.  */
  57.  
  58. int
  59. Tcl_GetInt(interp, string, intPtr)
  60.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  61.     char *string;        /* String containing a (possibly signed)
  62.                  * integer in a form acceptable to strtol. */
  63.     int *intPtr;        /* Place to store converted result. */
  64. {
  65.     char *end, *p;
  66.     int i;
  67.  
  68.     /*
  69.      * Note: use strtoul instead of strtol for integer conversions
  70.      * to allow full-size unsigned numbers, but don't depend on strtoul
  71.      * to handle sign characters;  it won't in some implementations.
  72.      */
  73.  
  74.     for (p = string; isspace(UCHAR(*p)); p++) {
  75.     /* Empty loop body. */
  76.     }
  77.     if (*p == '-') {
  78.     i = -strtoul(p+1, &end, 0);
  79.     } else if (*p == '+') {
  80.     i = strtoul(p+1, &end, 0);
  81.     } else {
  82.     i = strtoul(p, &end, 0);
  83.     }
  84.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  85.     end++;
  86.     }
  87.     if ((end == string) || (*end != 0)) {
  88.     Tcl_AppendResult(interp, "expected integer but got \"", string,
  89.         "\"", (char *) NULL);
  90.     return TCL_ERROR;
  91.     }
  92.     *intPtr = i;
  93.     return TCL_OK;
  94. }
  95.  
  96. /*
  97.  *----------------------------------------------------------------------
  98.  *
  99.  * Tcl_GetDouble --
  100.  *
  101.  *    Given a string, produce the corresponding double-precision
  102.  *    floating-point value.
  103.  *
  104.  * Results:
  105.  *    The return value is normally TCL_OK;  in this case *doublePtr
  106.  *    will be set to the double-precision value equivalent to string.
  107.  *    If string is improperly formed then TCL_ERROR is returned and
  108.  *    an error message will be left in interp->result.
  109.  *
  110.  * Side effects:
  111.  *    None.
  112.  *
  113.  *----------------------------------------------------------------------
  114.  */
  115.  
  116. int
  117. Tcl_GetDouble(interp, string, doublePtr)
  118.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  119.     char *string;        /* String containing a floating-point number
  120.                  * in a form acceptable to strtod. */
  121.     double *doublePtr;        /* Place to store converted result. */
  122. {
  123.     char *end;
  124.     double d;
  125.  
  126.     d = strtod(string, &end);
  127.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  128.     end++;
  129.     }
  130.     if ((end == string) || (*end != 0)) {
  131.     Tcl_AppendResult(interp, "expected floating-point number but got \"",
  132.         string, "\"", (char *) NULL);
  133.     return TCL_ERROR;
  134.     }
  135.     *doublePtr = d;
  136.     return TCL_OK;
  137. }
  138.  
  139. /*
  140.  *----------------------------------------------------------------------
  141.  *
  142.  * Tcl_GetBoolean --
  143.  *
  144.  *    Given a string, return a 0/1 boolean value corresponding
  145.  *    to the string.
  146.  *
  147.  * Results:
  148.  *    The return value is normally TCL_OK;  in this case *boolPtr
  149.  *    will be set to the 0/1 value equivalent to string.  If
  150.  *    string is improperly formed then TCL_ERROR is returned and
  151.  *    an error message will be left in interp->result.
  152.  *
  153.  * Side effects:
  154.  *    None.
  155.  *
  156.  *----------------------------------------------------------------------
  157.  */
  158.  
  159. int
  160. Tcl_GetBoolean(interp, string, boolPtr)
  161.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  162.     char *string;        /* String containing a boolean number
  163.                  * specified either as 1/0 or true/false or
  164.                  * yes/no. */
  165.     int *boolPtr;        /* Place to store converted result, which
  166.                  * will be 0 or 1. */
  167. {
  168.     char c;
  169.     char lowerCase[10];
  170.     int i, length;
  171.  
  172.     /*
  173.      * Convert the input string to all lower-case.
  174.      */
  175.  
  176.     for (i = 0; i < 9; i++) {
  177.     c = string[i];
  178.     if (c == 0) {
  179.         break;
  180.     }
  181.     if ((c >= 'A') && (c <= 'Z')) {
  182.         c += 'a' - 'A';
  183.     }
  184.     lowerCase[i] = c;
  185.     }
  186.     lowerCase[i] = 0;
  187.  
  188.     length = strlen(lowerCase);
  189.     c = lowerCase[0];
  190.     if ((c == '0') && (lowerCase[1] == '\0')) {
  191.     *boolPtr = 0;
  192.     } else if ((c == '1') && (lowerCase[1] == '\0')) {
  193.     *boolPtr = 1;
  194.     } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
  195.     *boolPtr = 1;
  196.     } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
  197.     *boolPtr = 0;
  198.     } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
  199.     *boolPtr = 1;
  200.     } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
  201.     *boolPtr = 0;
  202.     } else if ((c == 'o') && (length >= 2)) {
  203.     if (strncmp(lowerCase, "on", length) == 0) {
  204.         *boolPtr = 1;
  205.     } else if (strncmp(lowerCase, "off", length) == 0) {
  206.         *boolPtr = 0;
  207.     }
  208.     } else {
  209.     Tcl_AppendResult(interp, "expected boolean value but got \"",
  210.         string, "\"", (char *) NULL);
  211.     return TCL_ERROR;
  212.     }
  213.     return TCL_OK;
  214. }
  215.